home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Icon 8.1 / mem / MPW Helpers / Procedures / isort.icn < prev    next >
Encoding:
Text File  |  1992-05-29  |  2.1 KB  |  68 lines  |  [TEXT/MPS ]
  1. ############################################################################
  2. #
  3. #    Name:    isort.icn
  4. #
  5. #    Title:    Customizable sort procedure
  6. #
  7. #    Author:    Robert J. Alexander
  8. #
  9. #    Date:    April 3, 1992
  10. #
  11. ############################################################################
  12. #
  13. #  Customizable sort procedure for inclusion in Icon programs.
  14. #
  15. #       isort(x,keyproc,y)
  16. #
  17. #  Argument x can be any Icon data type that is divisible into elements
  18. #  by the unary element generation (!) operator.  The result is a list
  19. #  of the objects in sorted order.
  20. #
  21. #  The default is to sort elements in their natural, Icon-defined order.
  22. #  However, an optional parameter (keyproc) allows a sort key to be
  23. #  derived from each element, rather than the default of using the
  24. #  element itself as the key.  Keyproc can be a procedure provided by
  25. #  the caller, in which case the first argument to the key procedure is
  26. #  the item for which the key is to be computed, and the second argument
  27. #  is isort's argument y, passed unchanged.  The keyproc must produce
  28. #  the extracted key.  Alternatively, the keyproc argument can be an
  29. #  integer, in which case it specifies a subscript to be applied to each
  30. #  item to produce a key.  Keyproc will be called once for each element
  31. #  of structure x.
  32. #
  33. #
  34. #
  35.  
  36. procedure isort(x,keyproc,y)
  37.    local items,item,key,result
  38.    if not ((\function)() == "sortf") then return old_isort(x,keyproc,y)
  39.    if /keyproc | integer(keyproc) then return sortf(x,keyproc)
  40.    items := []
  41.    every item := !x do
  42.       put(items,[keyproc(item,y),item])
  43.    items := sortf(items,1)
  44.    result := []
  45.    while put(result,get(items)[2])
  46.    return result
  47. end
  48.  
  49. #
  50. #  This old version of isort works in Icon implementations not containing
  51. #  the sortf() function.
  52. #
  53. procedure old_isort(x,keyproc,y)
  54.    local items,item,key,result
  55.    if y := integer(keyproc) then
  56.      keyproc := proc("[]",2)
  57.    else /keyproc := 1
  58.    items := table()
  59.    every item := !x do {
  60.       key := keyproc(item,y)
  61.       (/items[key] := [item]) | put(items[key],item)
  62.       }
  63.    items := sort(items,3)
  64.    result := []
  65.    while get(items) do every put(result,!get(items))
  66.    return result
  67. end
  68.